

#|____________________________________________________________________
 |
 |                  CLOCK -  The Dynamic ViSta TimePiece
 |                 Copyright (c) 2001 by Forrest W. Young
 |                           All rights reserved 
 |____________________________________________________________________
 |
 | Possible future bells and whistles
 | 0) Turn into a proper object
 | 1) Clean up logoobj code
 | 2) Pop-up menu when right click clock window with same functionality as dialog box
 | 3) Change colors (static/dynamic)
 | 4) Control Speed from menu item
 | 5) Rotation (in addition to transforming) gliding/flying/zooming
 | 6) Roaming/zooming window
 | 7) Screen-saver without interfeering with keystrokes
 |____________________________________________________________________
 |
 |These default defaults are set in maketime\defvar.lsp
 |The distribution defaults are set by the (write-prefload-file) function
 |of the maketime\defpref.lsp file. This function is also used to
 |remember values from one session to the next.
 |
 | (setf *clock* nil)
 | (setf *show-clock-logo* nil)
 | (setf *clock-hides-desktop* nil)
 | (setf *full-screen-clock* nil)
 | (setf *dynamic-clock-logo* nil)
 | (setf *show-elapsed-time* t)
 |____________________________________________________________________
 |#


(setf *show-elapsed-time* nil)
(setf *clock-hides-desktop* t); typeing to difficult when showing, so always hide

(defun get-time ()
    (let ((dt (date-time)))
      (list (third dt) (first dt) (second dt))))

(defun clock-options ()
  (let ((scl? *show-clock-logo*)
        (choices (choose-subset-dialog
                  "Select Clock Options"
                  (list 
                   "Full Screen"
                   "Dynamic"
                   "Show Elapsed Time"
                   "Clock Only"
                   ;"Hide DeskTop"
                   ;"Change Logo Colors"
                   )
                  :initial 
                  (which 
                   (list 
                    *full-screen-clock* 
                    *dynamic-clock-logo*
                    *show-elapsed-time*
                    (not *show-clock-logo*)
                    ;*clock-hides-desktop* 
                    ;nil
                    )))))
    (when choices
          (when (first choices) (setf choices (first choices)))
          ;(setf *clock-hides-desktop* (not (not (member 0 choices))))
          (setf *full-screen-clock* (not (not (member 0 choices))))
          (setf *dynamic-clock-logo* (not (not (member 1 choices))))
          (when *clock* (send *clock* :animate *dynamic-clock-logo*))
          (setf *show-elapsed-time* (not (not (member 2 choices))))
          (setf *show-clock-logo* (not (member 3 choices)))
          (when (and (not scl?) *show-clock-logo* *clock*)
                (apply 'send *clock* :location 
                       (- (effective-screen-size) '(200 100) '(4 2)))
                (send *clock* :size 200 100))
          (when (not *show-clock-logo*) (setf *dynamic-clock-logo* nil))
          ; (when (member 4 choices) (change-logo-colors))
          )))


(defun countdown-timer ()
(print "hi")
  )

(defun change-logo-colors ()
  )

(setf *clock-copyright* nil)

(defun clock-copyright ()
  (setf *clock-copyright* t)
  (clock :full-screen nil :clock-copyright t :static t))

(defun clock (&key (full-screen *full-screen-clock* )
                   (show-elapsed-time *show-elapsed-time*) 
                   (back-color 'black) (draw-color 'yellow)
                   (static (not *dynamic-clock-logo*)))
"Args: &KEY (full-screen *full-screen-clock* ) (show-elapsed-time *show-elapsed-time*) (back-color 'black) (draw-color 'yellow) (static (not *dynamic-clock-logo*)
Shows the ViSta clock with two lines of text at bottom. Unless INFO is true the date and time information appears. If INFO is true, text about closing the window appears."
  (when (not (send *desktop-container* :has-slot 'showing))
        (send *desktop-container* :add-slot 'showing (second (date-time)))
        (defmeth *desktop-container* :showing (&optional (logical nil set))
          (if set (setf (slot-value 'showing) logical))
          (slot-value 'showing)))

  (when (boundp '*clock*)
        (when *clock*
              (when (and *clock* (not (not *clock*)))
                    (send *clock* :remove))))

  (let ((clock-size (if *show-clock-logo* '(225 125) '(225 50)))
        )
    (when *clock-copyright* (setf (select clock-size 0) '326))
    (setf *clock* (twiddle :text  '(" " " " " ")
                           :hide-logo (not *show-clock-logo*)
                           :static (if *show-clock-logo* static t)
                           :title " "
;leaving no room for logo causes error so must use size
;this way here, and set size below as shown
                           :size clock-size
                           :location (- (effective-screen-size) clock-size '(4 2))
                           :draw-color draw-color :back-color back-color
                           ;:full-screen full-screen
                           :margin (list 10 10 10 50)
                           :x (floor (/ 140 2)) :y  (- 80 28)
                           :justify "center"
                           :speed .1 ))
    (apply #'send *clock* :size clock-size)
    (send *clock*  :bottom-most)
    (send *clock* :add-slot 'start-time (get-internal-real-time))
    (defmeth *clock* :start-time (&optional (lol-of-strings nil set))
      (if set (setf (slot-value 'start-time) lol-of-strings))
      (slot-value 'start-time))
    (send *clock* :add-slot 'time (second (date-time)))
    (defmeth *clock* :time (&optional (lol-of-strings nil set))
    (if set (setf (slot-value 'time) lol-of-strings))
    (slot-value 'time))
    )


  (defmeth *clock* :do-idle ()
    ;(if *show-clock-logo* 
        (call-next-method)
     ;   (send self :start-buffering))
    (let* ((start-time (send self :start-time))
           (elapsed-time nil)
           (date-time (date-time))
           (old-time (send self :time))
           (now-time (sixth (date-time)))
           (th (+ (send self :text-ascent) (send self :text-descent)))
           (date (fifth date-time))
           (long-date (first date-time))
           (day (third date-time))
           (text-list)
           (nlines 3) 
           )
      (when (not (equal now-time old-time))
            (send self :time now-time)
            (send self :redraw)
            (setf elapsed-time (/ (- (get-internal-real-time) start-time)
                                  INTERNAL-TIME-UNITS-PER-SECOND))
            (setf text-list
                  (cond
                    (*clock-copyright* (vista-copyright))
                    ((not *show-clock-logo*)
                     (list (strcat day ", " long-date)
                           (strcat (send self :time) "  " (elapsed-time) 
                                   " ("  (elapsed-time elapsed-time) ")")
                           "Click=ViSta  Close=Exit"))
                    (show-elapsed-time
                     (list (strcat day ", " long-date)
                           (strcat (send self :time) "  " (elapsed-time) 
                                   " ("  (elapsed-time elapsed-time) ")")
                           "Click=ViSta  Close=Exit"))
                    (t
                     (list (strcat day ", " long-date)
                           (send self :time)
                           "Click=ViSta      Close=Exit"))))
            (send self :write text-list
                  (floor (/ (first (send self :size)) 2))
                  (- (second (send self :size)) (* th nlines)))
            (send self :x (floor (/ (first (send self :size)) 2)))
            (send self :y (- (second (send self :size)) (* th nlines))))
      (when (and *clock-copyright* (> elapsed-time 5))
            (setf *clock-copyright* nil)
            (send self :do-click 10 10 t t))
       ))


  (show-clock-not-desk)

(defmeth *clock* :redraw ()
  (send self :start-buffering)
  (call-next-method)
  (send self :buffer-to-screen))

 (defmeth *clock* :resize ()
   (call-next-method)
   (send self :redraw))
 

  (defmeth *clock* :get-time ()
    (let ((dt (date-time)))
      (list (third dt) (first dt) (second dt))))

  (defmeth *clock* :do-click (x y m1 m2)
    (when *help-control-panel* 
          (send *help-control-panel* :show-window))
    (send self :remove)
    (show-vista))

 ;(defmeth *clock* :do-click (x y m1 m2)
  ;  (send (send self :menu) :popup-menu (+ x 2) (+ y 2) *clock*))
  
  (defmeth *clock* :do-key (x y m1 m2)
    (show-vista)(send self :remove))
  
  (defmeth *clock* :close ()
    (send self :remove)
    (setf *clock-copyright* nil)
    (send *desktop-container* :close))

  (defmeth *clock* :remove ()
    (send *clock* :idle-on nil)
    (defmeth *clock* :close ()
      (send self :remove))
    (call-next-method)
    (setf *clock* nil))

  (send *clock* :top-most t)
  (send *clock* :idle-on  t)
  (when full-screen 
        (apply #'send *clock* :frame-size (screen-size))
        (send *clock* :frame-location 0 0))
  *clock*)


(defun run-time-string ()
  (let* ((min-decimal (multiple-value-list (floor (run-time))))
         (minutes (first min-decimal))
         (seconds (round (* 60 (second min-decimal)))))
    (format nil "~a:~a" minutes seconds)))

(defun elapsed-time (&optional (time (* 60 (run-time))))
  (let* ((seconds (floor (rem time 60)))
         (minutes (floor (rem (/ time 60) 60)))
         (hours (floor (/ time 3600)))
         (hours-string (if (< hours 1) "" (format nil "~a:" hours)))
         (seconds-string (format nil (if (< seconds 10) ":0~a" ":~a")
                                 seconds))
         (minutes-string 
          (format nil (if (< hours 1) (format nil "~a" minutes)
                          (if (< minutes 10) (format nil "0~a" minutes)
                              (format nil "~a" minutes)))))
         )
    (strcat hours-string minutes-string seconds-string)))


(defun make-clock ()(clock))

(defmeth logo-proto :make-clock ()
  (clock))

(defun switch-desktop-and-clock ()
  (cond 
    ((send *desktop-container* :showing)
     (if *clock-hides-desktop*  (hide-desktop))
     (show-clock))
    (t
     (hide-clock)
     (show-desktop))))

(defun show-clock ()
  (cond
    ((not *clock*) (clock))
    ((not (send *clock* :showing)) (clock))
    ))

(defun clock-hides-desktop (value)
  (setf *clock-hides-desktop* value)
  (when (and *clock-hides-desktop*
             (send *desktop-container* :showing))
        (hide-desktop)))
      

(defun show-clock-not-desk ()
  (when (and *clock-hides-desktop* (send *desktop-container* :showing))
        (send *desktop-container* :hide-window)
        (when *help-control-panel*
              (send *help-control-panel* :hide-window)))
  (cond
    ((not *clock*) (clock))
    ((not (send *clock* :showing)) (clock)))
  )

(defun hide-clock ()
  (cond
    ((not *clock*))
    ((send *clock* :showing)
     (send logo-proto :close))))

(defun close-clock ()
  (cond
    ((not *clock*))
    ((send *clock* :showing)
     (send logo-proto :close))))

(defun startup-clock ()
  (send *logo* :remove)
  (send *workmap* :idle-on nil)
  (clock)
  t)
